home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / SYSTEM~1 / SYSCOL~1.FRM < prev    next >
Text File  |  1997-06-09  |  6KB  |  216 lines
  1. VERSION 5.00
  2. Object = "*\ASysColorControl.vbp"
  3. Begin VB.Form frmSysColors 
  4.    Caption         =   "ActiveX System Color Control Sample"
  5.    ClientHeight    =   4485
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   4770
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   4485
  11.    ScaleWidth      =   4770
  12.    StartUpPosition =   2  'CenterScreen
  13.    Begin VB.CommandButton cmdPopup 
  14.       Caption         =   "&Popup"
  15.       Height          =   375
  16.       Left            =   3000
  17.       TabIndex        =   4
  18.       ToolTipText     =   "Display Popup Palette"
  19.       Top             =   3120
  20.       Width           =   1455
  21.    End
  22.    Begin VB.CommandButton cmdClick 
  23.       Caption         =   "Set to Single &Click"
  24.       Height          =   375
  25.       Left            =   720
  26.       TabIndex        =   3
  27.       ToolTipText     =   "Change ClickType"
  28.       Top             =   3960
  29.       Width           =   1575
  30.    End
  31.    Begin SystemColorControl.SysColors SysColors1 
  32.       Height          =   2235
  33.       Left            =   360
  34.       TabIndex        =   2
  35.       ToolTipText     =   "Select a Color"
  36.       Top             =   1560
  37.       Width           =   2310
  38.       _ExtentX        =   4075
  39.       _ExtentY        =   3942
  40.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  41.          Name            =   "MS Sans Serif"
  42.          Size            =   8.25
  43.          Charset         =   0
  44.          Weight          =   400
  45.          Underline       =   0   'False
  46.          Italic          =   0   'False
  47.          Strikethrough   =   0   'False
  48.       EndProperty
  49.       DefaultColor    =   8
  50.    End
  51.    Begin VB.CommandButton cmdExit 
  52.       Caption         =   "&Exit"
  53.       Height          =   375
  54.       Left            =   3240
  55.       TabIndex        =   1
  56.       ToolTipText     =   "Exit Sample"
  57.       Top             =   3960
  58.       Width           =   855
  59.    End
  60.    Begin VB.Label Label2 
  61.       AutoSize        =   -1  'True
  62.       Caption         =   "Double Click Mode"
  63.       Height          =   195
  64.       Left            =   360
  65.       TabIndex        =   10
  66.       Top             =   1320
  67.       Width           =   1350
  68.    End
  69.    Begin VB.Label Label1 
  70.       AutoSize        =   -1  'True
  71.       Caption         =   "System Color Value"
  72.       Height          =   195
  73.       Left            =   720
  74.       TabIndex        =   9
  75.       Top             =   720
  76.       Width           =   1365
  77.    End
  78.    Begin VB.Label ShowValue 
  79.       Alignment       =   2  'Center
  80.       BackColor       =   &H80000005&
  81.       BorderStyle     =   1  'Fixed Single
  82.       Height          =   255
  83.       Left            =   360
  84.       MouseIcon       =   "SysColorCtl.frx":0000
  85.       MousePointer    =   99  'Custom
  86.       TabIndex        =   8
  87.       ToolTipText     =   "Click for Hex Conversion"
  88.       Top             =   960
  89.       Width           =   2295
  90.    End
  91.    Begin VB.Label Label4 
  92.       AutoSize        =   -1  'True
  93.       Caption         =   "Color Display"
  94.       Height          =   195
  95.       Left            =   3240
  96.       TabIndex        =   7
  97.       Top             =   120
  98.       Width           =   915
  99.    End
  100.    Begin VB.Label Label3 
  101.       AutoSize        =   -1  'True
  102.       Caption         =   "System Color Name"
  103.       Height          =   195
  104.       Left            =   720
  105.       TabIndex        =   6
  106.       Top             =   120
  107.       Width           =   1380
  108.    End
  109.    Begin VB.Label ShowColor 
  110.       BorderStyle     =   1  'Fixed Single
  111.       Height          =   975
  112.       Left            =   2880
  113.       TabIndex        =   5
  114.       Top             =   360
  115.       Width           =   1695
  116.    End
  117.    Begin VB.Label ShowName 
  118.       Alignment       =   2  'Center
  119.       BackColor       =   &H80000005&
  120.       BorderStyle     =   1  'Fixed Single
  121.       Height          =   255
  122.       Left            =   360
  123.       TabIndex        =   0
  124.       Top             =   360
  125.       Width           =   2295
  126.    End
  127. End
  128. Attribute VB_Name = "frmSysColors"
  129. Attribute VB_GlobalNameSpace = False
  130. Attribute VB_Creatable = False
  131. Attribute VB_PredeclaredId = True
  132. Attribute VB_Exposed = False
  133. Option Explicit
  134.  
  135. 'System Color Palette 1.0 - Sample Program
  136. 'Created by Randy Russell - June 1997
  137. 'Created using Microsoft Visual Basic 5.0
  138. Dim MyColorVal As Long 'store color value for hex conversion
  139. Dim MyPal As New clsSysColors
  140.  
  141. Private Sub cmdClick_Click()
  142.  'demonstrates use of the ClickType property
  143.  If SysColors1.ClickType = 2 Then
  144.   SysColors1.ClickType = 1
  145.   cmdClick.Caption = "Set to Double &Click"
  146.   Label2.Caption = "Single Click Mode"
  147.  Else
  148.   SysColors1.ClickType = 2
  149.   cmdClick.Caption = "Set to Single &Click"
  150.   Label2.Caption = "Double Click Mode"
  151.  End If
  152. End Sub
  153.  
  154. Private Sub cmdExit_Click()
  155.  Unload Me
  156. End Sub
  157.  
  158. Private Sub cmdPopup_Click()
  159.  'display popup palette
  160.  Dim X As Single, Y As Single
  161.  X = ((Width - 2310) / 2) + Left
  162.  Y = Top + 4000
  163.  MyPal.Popup X, Y
  164.  'if user did not cancel then get selection and update display
  165.  If MyPal.ColorName <> "" Then
  166.   MyColorVal = MyPal.Color 'color value
  167.   ShowColor.BackColor = MyColorVal
  168.   ShowValue.Caption = MyColorVal
  169.   ShowName.Caption = MyPal.ColorName 'color name
  170.   SysColors1.SetColor MyPal.ColorName
  171.  End If
  172. End Sub
  173.  
  174. Private Sub Form_Load()
  175.  'display defaults
  176.  SetColors
  177.  If SysColors1.ClickType = 2 Then
  178.   cmdClick.Caption = "Set to Single &Click"
  179.  Else
  180.   cmdClick.Caption = "Set to Double &Click"
  181.  End If
  182. End Sub
  183.  
  184. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  185.  Set MyPal = Nothing
  186. End Sub
  187.  
  188. Private Sub ShowValue_Click()
  189. 'switch between hex and decimal display
  190. Static fhex As Boolean
  191.  If fhex Then
  192.   ShowValue.Caption = MyColorVal
  193.   ShowValue.ToolTipText = "Click for Hex Conversion"
  194.   fhex = False
  195.  Else
  196.   ShowValue.Caption = "h" & Hex(MyColorVal)
  197.   ShowValue.ToolTipText = "Click for Long Conversion"
  198.   fhex = True
  199.  End If
  200. End Sub
  201.  
  202. Private Sub SysColors1_Click()
  203.  'if user did not cancel then get selection and update display
  204.  If SysColors1.SelectedColorName <> "" Then
  205.   SetColors
  206.  End If
  207. End Sub
  208.  
  209. Private Sub SetColors()
  210.  'update display with new system color
  211.   MyColorVal = SysColors1.SelectedColor
  212.   ShowColor.BackColor = MyColorVal
  213.   ShowValue.Caption = MyColorVal
  214.   ShowName.Caption = SysColors1.SelectedColorName
  215. End Sub
  216.